home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / sweep11 / grid.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  15KB  |  433 lines
  1. unit Grid;
  2. interface
  3. uses
  4. WinTypes,WinProcs,Messages,Forms,Grids,Menus,SwpLogic,ExtCtrls,Controls,Classes,
  5.   StdCtrls;
  6. type
  7. FACETYPE = (FACEDOWN ,FACECOOL,FACESAD,FACETENSE,FACEUP);
  8. GAMETYPE = (BEGINNER,INTERMEDIATE,EXPERT,CUSTOM);
  9. TSweepForm = class(TForm)
  10. {This is where the game pieces are put }
  11.     GameGrid               : TDrawGrid;
  12. {Panel Objects for drawing highlighted areas on the game board }
  13.     FormPanel              : TPanel;
  14.     ScorePanel             : TPanel;
  15.     GamePanel              : TPanel;
  16.     TimePanel              : TPanel;
  17.     MinePanel              : TPanel;
  18. {Menu Variables}
  19.     SweepMenu              : TMainMenu;
  20.       New2                 : TMenuItem;
  21.       Beginner1            : TMenuItem;
  22.       Intermediate1        : TMenuItem;
  23.       Expert1              : TMenuItem;
  24.       Exit1                : TMenuItem;
  25.       About1               : TMenuItem;
  26. {TImages That hold Invisible Bitmaps}
  27.     AllButtons             : TImage;       {Source of GameGrid's Buttons}
  28.     FACES                  : TImage;
  29.     LEDS                   : TImage;
  30. {TImages That are Visible but are sourced from invisible Bmps above}
  31.     FacePictureBox        : TImage;
  32.     MinesPicture          : TImage;
  33.     TimePicture           : TImage;
  34.     GameTimer: TTimer;
  35. {Menu Related Functions}
  36.     procedure NewGame(gType : GAMETYPE;Mines,HorzTiles, VertTiles : Integer ) ;
  37.     procedure Intermediate1Click(Sender: TObject);
  38.     procedure Beginner1Click(Sender: TObject);
  39.     procedure Expert1Click(Sender: TObject);
  40.     procedure Exit1Click(Sender: TObject);
  41.     procedure New2Click(Sender: TObject);
  42. {Grid Related Functions}
  43.     procedure PaintCell(Sender: TObject; Col, Row: Longint; Rect: TRect;
  44.       State: TGridDrawState);
  45.     function GetGameTile(I,J:Integer;State: TGridDrawState):Integer;
  46.     procedure GameGridMouseUp(Sender: TObject; Button: TMouseButton;
  47.       Shift: TShiftState; X, Y: Integer);
  48.     procedure GameGridMouseMove(Sender: TObject; Shift: TShiftState; X,
  49.       Y: Integer);
  50.     procedure GameGridMouseDown(Sender: TObject; Button: TMouseButton;
  51.       Shift: TShiftState; X, Y: Integer);
  52.     procedure SetShiftedSelection(X,Y : Integer; onOff : Boolean);
  53. {Form Handling Functions}
  54.     procedure PlaceControls;
  55.     procedure FormDestroy(Sender: TObject);
  56.     procedure FormCreate(Sender: TObject);
  57.     procedure GameTimerTimer(Sender: TObject);
  58. {Face Handleing Functions}
  59.     procedure FacePictureBoxClick(Sender: TObject);
  60.     procedure FacePictureBoxMouseDown(Sender: TObject;
  61.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  62.     procedure ToggleFace(Face : FACETYPE);
  63.     procedure FacePictureBoxMouseUp(Sender: TObject; Button: TMouseButton;
  64.       Shift: TShiftState; X, Y: Integer);
  65.     procedure FacePictureBoxMouseMove(Sender: TObject; Shift: TShiftState;
  66.       X, Y: Integer);
  67. {LED Handling Function}
  68.     procedure PrintDigits(NTime : Integer;LEDPICTURE : TImage);
  69.     procedure About1Click(Sender: TObject);
  70.   private
  71.     hGameHandle                                        : HSWP;
  72.     gmType                                             : GameType;
  73.     LastSel                                            : TGridRect;
  74.     MouseDown,Shifted,EatClick                         : Boolean;
  75.     LastX, LastY, NHorzTiles, NVertTiles, NMines       : Integer;
  76. {User defined Message Handling Functions}
  77.     procedure HandleGameTime(var msg : TMessage); message WM_SWEEPTIMER;
  78.     procedure HandleFlipCell(var msg : TMessage); message WM_BLANKCELL;
  79.     procedure HandleFocusTo (var msg : TMessage); message WM_SETFOCUS;
  80.     procedure CheckGameState;
  81.   public
  82. end;
  83. var
  84.   SweepForm: TSweepForm;
  85. implementation
  86. const DIG_SET : Set Of Char = ['-',' ','9','8','7','6','5','4','3','2','1','0'];
  87. const TileWidth  = 16;    {Width  of Allutons BMP}
  88. const TileHeight = 16;    {Height of a Single Button Element in Tall Bitmap}
  89. const FaceWidth  = 24;    {Width  of FACES BMP}
  90. const FaceHeight = 24;    {Height of a Single FACE Element in Tall Bitmap}
  91. const LedWidth   = 13;    {Width of LED Bitmaps}
  92. const LedHeight  = 23;    {Height of a Single LED Element in Tall Bitmap}
  93. {$R *.DFM}
  94. {$R*.RES}
  95.  
  96. procedure TSweepForm.NewGame(gType : GAMETYPE;Mines,HorzTiles, VertTiles : Integer ) ;
  97. var  iErr : Integer;
  98. begin
  99.   gmType := gType;
  100.   Nmines := Mines;  NHorzTiles := HorzTiles;   NVertTiles := VertTiles;
  101.   logFreeGame(hGameHandle);
  102.   GameTimer.Enabled := False;
  103.   hGameHandle := logInitGame(NVertTiles,NHorzTiles,NMines, Handle,iErr);
  104.   PlaceControls;
  105. end;
  106.  
  107. procedure TSweepForm.Intermediate1Click(Sender: TObject);
  108. begin
  109.   NewGame(INTERMEDIATE,40,16,16);
  110. end;
  111.  
  112. procedure TSweepForm.Beginner1Click(Sender: TObject);
  113. begin
  114.    NewGame(BEGINNER,10,8,8);
  115. end;
  116.  
  117. procedure TSweepForm.Expert1Click(Sender: TObject);
  118. begin
  119.    NewGame(EXPERT,99,30,16);
  120. end;
  121.  
  122. procedure TSweepForm.PlaceControls;
  123.   var I , J : Integer;  R : TRect;
  124. begin
  125.      Width := 14*2 + NHorzTiles*TileWidth + 1;
  126.      Height := GameGrid.Top + NVertTiles*TileHeight +  GameGrid.Left +
  127.                (GetSystemMetrics(SM_CYCAPTION)+
  128.                 GetSystemMetrics(SM_CYMENU )) +1;
  129.      FormPanel.Width := Width - 2;
  130.      FormPanel.Height := Height - (GetSystemMetrics(SM_CYCAPTION)+
  131.                                    GetSystemMetrics(SM_CYMENU ))-2;
  132.      GamePanel.Width  := NHorzTiles*TileWidth + 6;
  133.      GamePanel.Height := NVertTiles*TileHeight + 6;
  134.      ScorePanel.Left := GamePanel.Left;
  135.      ScorePanel.Width := GamePanel.Width;
  136.      TimePanel.Left := ScorePanel.Width - (TimePanel.Width +  MinePanel.Left) ;
  137.  
  138.      GameGrid.Width := NHorzTiles*TileWidth;
  139.      GameGrid.Height := NVertTiles*TileHeight;
  140.      GameGrid.ColCount := NHorzTiles;  GameGrid.RowCount := NVertTiles;
  141.  
  142.      FacePictureBox.Left := Width div 2  - (FacePictureBox.Width )  ;
  143.      ToggleFace(FACEUP);
  144.      PrintDigits(0,TimePicture);
  145.      PrintDigits(NMines,MinesPicture) ;
  146.      for I := 0 To nVertTiles - 1 do
  147.        for J := 0 To nHorzTiles - 1 do
  148.          PaintCell(nil, J,I,R,[gdFixed]);
  149. end;
  150.  
  151. procedure TSweepForm.Exit1Click(Sender: TObject);
  152. begin
  153.    PostQuitMessage(0);
  154. end;
  155.  
  156. function TSweepForm.GetGameTile(I,J:Integer;State: TGridDrawState):Integer;
  157.   var gameState : Integer;
  158. begin
  159.   If ((gdSelected in State) and (MouseDown)) Then Begin
  160.     gameState := logGetGameState(hGameHandle);
  161.     if ((gameState = gmstPLAYING)             or
  162.         (gameState = gmstWAITING_AFTERRESET)) then
  163.          Result := logGetSideShown(hGameHandle,I,J)
  164.   End
  165.   Else Result := logGetValue(hGameHandle,I,J);
  166. end;
  167.  
  168. procedure TSweepForm.PaintCell(Sender: TObject; Col, Row: Longint;
  169.   Rect: TRect; State: TGridDrawState);
  170.   var  RectS,RectD :TRect;
  171.        I,J         : Integer;
  172.         gmState    : Integer;
  173.        h : THandle;
  174. begin
  175.      h := GetCapture;
  176.      if (h = GameGrid.Handle) Then
  177.        if ((LastX < 0 ) or  (LastX > GameGrid.Width) or
  178.            (LastY < 0)  or  (LastY > GameGrid.Height) )   then
  179.              if (gdSelected in State) Then
  180.                 Exit;
  181.      RectD.left := Col*TileWidth;
  182.      RectD.top  := Row*TileHeight;
  183.      rectD.right  := (RectD.Left + TileWidth);
  184.      RectD.Bottom := (RectD.Top  + TileHeight);
  185.      RectS.Top := GetGameTile(Row,Col,State)*TileHeight;
  186.  
  187.      RectS.Left := 0;
  188.      RectS.Bottom := RectS.Top+TileHeight;
  189.      RectS.Right := RectS.Left+TileWidth;
  190.      GameGrid.Canvas.CopyRect(RectD,AllButtons.Canvas,RectS);
  191. end;
  192.  
  193. procedure TSweepForm.PrintDigits(NTime : Integer; LEDPICTURE : TImage );
  194. function LedCharToIndex(Ch :char):Integer;
  195. begin
  196.     Case ch of
  197.       '0'..'9' : Result := 11 - (Ord(ch) - Ord('0'));
  198.       '-'      : Result := 0;
  199.       ' '      : Result := 1;
  200.       Else
  201.        ReSult := -1
  202.     End;
  203. end;
  204.    var RectS,RectD : TRect;
  205.        I           : Integer;
  206.        PStr        : Array[0..3] of char;
  207.        Dig         : Integer;
  208. begin
  209.     wvsprintf(Pstr,'%03d',NTime);
  210.     for I := 0 to 2 do begin
  211.          RectD.left   := I*LedWidth;
  212.          RectD.top    := 0;
  213.          rectD.right  := RectD.Left+LedWidth;
  214.          RectD.Bottom := LedHeight;
  215.          Dig := LedCharToIndex(Pstr[I]);
  216.          If (Dig >= 0) Then Begin
  217.            RectS.Top    := Dig*LEDHeight;
  218.            RectS.Left   := 0;
  219.            RectS.Bottom := RectS.Top+LEDHeight;
  220.            RectS.Right  := LedWidth;
  221.            LedPicture.Canvas.CopyRect(RectD,LEDS.Canvas,RectS );
  222.          End;
  223.      end;
  224. end;
  225.  
  226. procedure TSweepForm.FormCreate(Sender: TObject);
  227. var Err : Integer;
  228. begin
  229.     LastX := -1;     LastY := -1;
  230.     EatClick := False;
  231.     GameTimer.Enabled := False;
  232.     MouseDown := False;
  233.     Shifted := FALSE;
  234.     NVertTiles := 8;    NHorzTiles := 8;
  235.     NMines := 10;
  236.     ToggleFace(FaceUp);
  237.     PrintDigits(0,TimePicture);   PrintDigits(NMines,MinesPicture);
  238.     hGameHandle := logInitGame(NVertTiles,NHorzTiles,NMines,Handle,Err);
  239.     PlaceControls;
  240. end;
  241.  
  242. procedure TSweepForm.FacePictureBoxClick(Sender: TObject);
  243. begin
  244.     ToggleFace(FaceDown);
  245. end;
  246. procedure TSweepForm.GameGridMouseUp(Sender: TObject; Button: TMouseButton;
  247.   Shift: TShiftState; X, Y: Integer);
  248. var   I,J                     : LongInt;
  249.       RectD,RectS,R           : TRect;
  250.       pv,row,col    : Integer ;
  251. begin
  252.    MouseDown := False;
  253.    if EatClick Then
  254.    Begin
  255.     EatClick := False;
  256.     Exit;
  257.    End;
  258.  
  259.    GameGrid.MouseToCell(X,Y,J,I);
  260.    If (mbLeft = Button) Then  Begin
  261.         if (X <  GameGrid.Width  ) and (Y <  GameGrid.Height ) then
  262.            If (Shifted) Then logPlay(hGameHandle,I,J,1)
  263.               Else logPlay(hGameHandle,I,J,0);
  264.  
  265.         PaintCell(nil, J,I,R,[gdFixed]);
  266.         CheckGameState;
  267.    end
  268.    else
  269.    if (mbRight = Button)  then
  270.       If (not Shifted) Then   Begin
  271.         logSetFlag(hGameHandle,I,J);
  272.         PrintDigits(logGetMineCount(hGameHandle),MinesPicture);
  273.         PaintCell(nil,J,I,R,[gdFixed]);
  274.         CheckGameState;
  275.       End;
  276.    SetShiftedSelection(X,Y,False);
  277.    ReleaseCapture;
  278. end;
  279. procedure TSweepForm.CheckGameState;
  280.    var gameState : Integer;
  281. Begin
  282.  
  283. gameState := logGetGameState(hGameHandle);
  284.         Case gameState of
  285.          gmstPLAYING:begin ToggleFace(FACEUP);
  286.                            If (GameTimer.Enabled = False) Then
  287.                              GameTimer.Enabled := True;
  288.                      end;
  289.          gmstLOST  : begin  ToggleFace(FACESAD);
  290.                             GameTimer.Enabled := False;
  291.                      end;
  292.          gmstWON   : begin  ToggleFace(FACECOOL);
  293.                             GameTimer.Enabled := False;
  294.                      end;
  295.          else        ToggleFace(FACEUP);
  296.         End;
  297. End;
  298. procedure TSweepForm.GameGridMouseMove(Sender: TObject; Shift: TShiftState;
  299.   X, Y: Integer);
  300. var R            : TRect;
  301.     I,J          : Integer;
  302.     II,JJ,Adder  : LongInt;
  303.     Sel          : TGridRect;
  304. begin
  305.  LastX := X; LastY := Y;
  306.  if (ssLeft in Shift) then
  307.   if ((X >= 0 ) and  (X <=GameGrid.Width)     and
  308.       (Y >= 0)  and  (Y <= GameGrid.Height) ) then  begin
  309.           for J := LastSel.Left To LastSel.Right do
  310.               for I := LastSel.Top To LastSel.Bottom do
  311.                   PaintCell(nil, J, I,R,[gdFixed]);
  312.           if (Shifted)    Then
  313.             SetShiftedSelection(X,Y,True);
  314.      end;
  315. end;
  316.  
  317. procedure TSweepForm.GameGridMouseDown(Sender: TObject;
  318.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  319.   var  gameState : Integer;
  320. begin
  321.   if (Button = mbLeft) Then  Begin
  322.     SetCapture (GameGrid.Handle);
  323.     MouseDown := True;
  324.     gameState := logGetGameState(hGameHandle);
  325.      if ((gameState = gmstPLAYING) or
  326.          (gameState = gmstWAITING_AFTERRESET)) Then
  327.                     ToggleFace(FaceTense);
  328.     if ((ssShift in Shift) or Shifted) Then
  329.       SetShiftedSelection(X,Y,True);
  330.    End
  331.    Else
  332.    if((Button = mbRight) and  (MouseDown = True)) Then
  333.       SetShiftedSelection(X,Y,TRUE);
  334. end;
  335.  
  336. procedure TSweepForm.SetShiftedSelection(X,Y : Integer; onOff : Boolean);
  337. var  II,JJ,Adder : LongInt; Sel         : TGridRect;
  338. begin
  339.      GameGrid.MouseToCell(X,Y,II,JJ);
  340.      Shifted := onOff;
  341.      if (onOff) Then  Adder := 1  Else  Adder := 0;
  342.  
  343.      Sel.Left := II - Adder;    Sel.Right:= II + Adder;
  344.      Sel.Top  := JJ - Adder;    Sel.Bottom := JJ + Adder;
  345.  
  346.      if (Sel.Left < 0 )                   then    Sel.Left := 0;
  347.      if (Sel.Right >= NHorzTiles)         then    Sel.Right := NHorzTiles - 1;
  348.      if (Sel.Top < 0 )                    then    Sel.Top := 0;
  349.      if (Sel.Bottom >= NVertTiles)        then    Sel.Bottom := NVertTiles - 1;
  350.  
  351.      GameGrid.Selection := Sel;
  352. end;
  353.  
  354. procedure TSweepForm.FacePictureBoxMouseDown(Sender: TObject;
  355.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  356. begin
  357.    ToggleFace(FaceDown);
  358. end;
  359.  
  360. procedure TSweepForm.ToggleFace(Face : FACETYPE);
  361.  var RectS,RectD : TRect;
  362. begin
  363.     RectD.left := 0;
  364.     RectD.top  := 0;
  365.     rectD.right  := FaceWidth;
  366.     RectD.Bottom := FaceHeight;
  367.     RectS.Top := Ord(Face)*FaceHeight;
  368.     RectS.Left := 0;
  369.     RectS.Bottom := RectS.Top+FaceHeight;
  370.     RectS.Right := FaceWidth;
  371.     FacePictureBox.Canvas.CopyRect(RectD,FaceS.Canvas,RectS );
  372. End;
  373.  
  374. procedure TSweepForm.FacePictureBoxMouseUp(Sender: TObject;
  375.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  376. begin
  377.      if ((X >= 0 ) and  (X <= FacePictureBox.Width)      and
  378.          (Y >= 0)  and  (Y <= FacePictureBox.Height) )   then begin
  379.        ToggleFace(FaceUP);
  380.        New2Click(nil);
  381.      end;
  382. end;
  383.  
  384. procedure TSweepForm.FormDestroy(Sender: TObject);
  385. begin
  386.   logFreeGame(hGameHandle);
  387. end;
  388.  
  389. procedure TSweepForm.FacePictureBoxMouseMove(Sender: TObject;
  390.   Shift: TShiftState; X, Y: Integer);
  391. begin
  392.  if ((X < 0 ) or  (X > FacePictureBox.Width )     or
  393.      (Y < 0)  or  (Y > FacePictureBox.Height) )   then ToggleFace(FaceUP);
  394. end;
  395.  
  396. procedure TSweepForm.New2Click(Sender: TObject);
  397. var  iErr : Integer;  r    : TRect;
  398. begin
  399.    logFreeGame(hGameHandle);
  400.    hGameHandle := logInitGame(NVertTiles,NHorzTiles, NMines,Handle,iErr);
  401.    PlaceControls;
  402. end;
  403.  
  404. procedure TSweepForm.HandleGameTime(var msg : TMessage);
  405. Begin
  406.   PrintDigits(msg.WParam,TimePicture);
  407. End;
  408.  
  409. procedure TSweepForm.HandleFlipCell(var msg : TMessage);
  410. var R : TRect ;
  411. Begin
  412.   PaintCell(nil,msg.LparamHI,msg.LParamLO,R,[gdFixed]);
  413. End;
  414.  
  415. procedure TSweepForm.GameTimerTimer(Sender: TObject);
  416. begin
  417.   logIncrementGameTime(hGameHandle);
  418. end;
  419.  
  420. procedure TSweepForm.HandleFocusTo(var msg : TMessage);
  421. Begin
  422.   if (msg.WParam <> Handle) Then
  423.     EatClick := True;
  424. End;
  425.  
  426. procedure TSweepForm.About1Click(Sender: TObject);
  427. begin
  428.     MessageBox(Handle,'Mark Wardell - Public Domain'#13'75142,415'#13'mwardell@deltanet.com',
  429.                       'Delphi Mine Sweeper ',MB_OK);
  430. end;
  431.  
  432. end.
  433.